Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/textimp.fr_/textimp.fr

Text File | 1995-07-05 | 17KB | 560 lines

VERSION 4.00
Begin VB.Form frmMain
   BackColor       =   &H00C0C0C0&
   Caption         =   "Text File Import"
   ClientHeight    =   4455
   ClientLeft      =   2280
   ClientTop       =   1545
   ClientWidth     =   4410
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   4860
   Left            =   2220
   LinkTopic       =   "Form1"
   ScaleHeight     =   4455
   ScaleWidth      =   4410
   Top             =   1200
   Width           =   4530
   Begin VB.CommandButton cmdListVendors
      Caption         =   "&List Vendors"
      Height          =   375
      Left            =   720
      TabIndex        =   5
      Top             =   1560
      Width           =   2955
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "Exit"
      Height          =   555
      Left            =   1620
      TabIndex        =   4
      Top             =   3720
      Width           =   1215
   End
   Begin VB.CommandButton cmdImport
      Caption         =   "&Import Data"
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   1080
      Width           =   2955
   End
   Begin VB.CommandButton cmdVendorDetails
      Caption         =   "&Vendor Details"
      Height          =   375
      Left            =   720
      TabIndex        =   1
      Top             =   2040
      Width           =   2955
   End
   Begin VB.ListBox lstVendors
      Height          =   810
      Left            =   480
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   180
      Width           =   3495
   End
   Begin MSGrid.Grid grdInvoices
      Height          =   975
      Left            =   240
      TabIndex        =   2
      Top             =   2580
      Width           =   3915
      _Version        =   65536
      _ExtentX        =   6906
      _ExtentY        =   1720
      _StockProps     =   77
      Cols            =   4
      ScrollBars      =   2
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private VendorFile As String
Private InvoiceFile As String
Private DatabaseFile As String
Private PathToData As String

Private Sub cmdExit_Click()
    End
End Sub
Private Sub cmdImport_Click()

    ' This procedure imports vendor and invoice text files named by the
    ' form-level constants VendorFile and InvoiceFile, respectively, and
    ' appends the records from them to the Vendors and Invoices tables in the
    ' database named in the DatabaseFile constant.

    Dim lineOfData As String
    Dim i As Integer
    Dim db As DATABASE
    Dim tblVendors As Recordset, tblInvoices As Recordset
    Dim errorMsg As String

    ' The needRollback variable is used to flag the error handler as to
    ' whether a Rollback is required. It is initially false and will be
    ' set to true immediately after the BeginTrans statement.

    Dim needRollback As Boolean

    ' The mext two declarations each create a new Collection object and
    ' assign a variable name to represent that object.

    Dim vendorsCollection As New Collection
    Dim invoicesCollection As New Collection

    ' The next two declarations define variables that will be set to
    ' class objects several places in this procedure.

    Dim ven As clsVendor
    Dim inv As clsInvoice

    ' Set up the error handler.

    On Error GoTo ImportTextError

    ' Turn on the hourglass.

    Screen.MousePointer = 11

    ' Open the vendor file and read in the records a line at a time. Assign
    ' each line to the variable lineOfData.

    Open VendorFile For Input As #1

    Do While Not EOF(1)

        Line Input #1, lineOfData

        ' Create a new clsVendor object and assign it to the variable ven.

        Set ven = New clsVendor

        ' Assign the line of data just read to the DelimitedString property of
        ' the clsVendor object using the Property Let Tabbed String routine.

        ven.DelimitedString = lineOfData

        ' Add the new object to the vendors collection.

        vendorsCollection.Add ven

    Loop

    ' Close the vendor text file.

    Close #1

    ' Open the invoice file and read in the records a line at a time. Assign
    ' each line to the variable lineOfData.

    Open InvoiceFile For Input As #1

    Do While Not EOF(1)

        Line Input #1, lineOfData

        ' Create a new clsInvoice object and assign it to the variable inv.

        Set inv = New clsInvoice

        ' Assign the line of data just read to the DelimitedString property of
        ' the clsInvoice object using the Property Let Tabbed String routine.

        inv.DelimitedString = lineOfData

        ' Add the new object to the invoices collection.

        invoicesCollection.Add inv

    Loop

    ' Close the vendor text file.

    Close #1

    ' Open the database and the Vendors and Invoices tables.

    Set db = DBEngine.Workspaces(0).OpenDatabase(DatabaseFile)
    Set tblVendors = db.OpenRecordset("Vendors", dbOpenTable)
    Set tblInvoices = db.OpenRecordset("Invoices", dbOpenTable)

    ' We want to import all the records or none of the records. Therefore,
    ' enclose the append operations in a transaction. Set the needRollback
    ' variable to True to flag the error handler to execute a rollback if
    ' an error occurs.

    BeginTrans
    needRollback = True

    ' Take each item in the vendors collection and append it to the
    ' vendors table.

    For i = 1 To vendorsCollection.Count

        Set ven = vendorsCollection.Item(i)
        If ven.StoreNewItem(tblVendors) = False Or ven.Number = 0 Then

            ' The Jet engine returned an error when we tried to append the
            ' record. Create a specific message informing the user of the
            ' record that caused the error and the specific error that
            ' occurred.

            errorMsg = "Error encountered importing vendor #"
            errorMsg = errorMsg & LTrim(Str$(ven.Number)) & ": " & Error(Err)

            ' Branch to the error-handler which rolls back the transaction
            ' and exits from the procedure.

            GoTo ImportTextError

        End If

    Next i

    ' Open the invoices table.

    For i = 1 To invoicesCollection.Count

        Set inv = invoicesCollection.Item(i)
        If inv.StoreNewItem(tblInvoices) = False Or inv.vendorNumber = 0 Then

            ' The Jet engine returned an error when we tried to append the
            ' record. Create a specific message informing the user of the
            ' record that caused the error and the specific error that
            ' occurred.

            errorMsg = "Error encountered importing invoice #"
            errorMsg = errorMsg & inv.invoiceNumber & " for vendor #"
            errorMsg = errorMsg & LTrim(Str$(ven.Number)) & ": " & Error(Err)

            ' Branch to the error-handler which rolls back the transaction
            ' and exits from the procedure.

            GoTo ImportTextError

        End If

    Next i

    ' No error occurred during the append routine, so tell the Jet engine
    ' to go ahead and commit the transaction.

    CommitTrans

    ' Restore the mouse pointer to its normal shape.

    Screen.MousePointer = 0

Exit Sub

ImportTextError:

    ' An error occurred during the import of the text files.

    ' Restore the mouse pointer to its normal shape.

    Screen.MousePointer = 0

    ' If no error message has been created in the body of the procedure,
    ' create a default error message.

    If errorMsg = "" Then
        errorMsg = "The following error has occurred: " & Error(Err)
    End If

    ' Add the following to the error message so the user knows that the
    ' original state of the Vendors and Invoices tables has not been changed.

    errorMsg = errorMsg & " No records have been added to the database."

    ' Display the error message. Since this error aborts the application,
    ' use the critical error icon.

    MsgBox errorMsg, vbExclamation

    ' If the transaction had started, needRollback is True. Roll back the
    ' transaction.

    If needRollback Then Rollback

Exit Sub

End Sub
Private Sub cmdVendorDetails_Click()

    ' This procedure displays a form with information about the vendor
    ' currently selected in the vendors list box.

    Dim db As DATABASE
    Dim tbl As Recordset
    Dim vendorNumber As Integer

    ' Set up the error handler.

    On Error GoTo VendorDetailsError

    If lstVendors.ListIndex > -1 Then

        ' The user has selected a vendor. Get the vendor number from the
        ' list box ItemData property and assign it to a variable.

        vendorNumber = lstVendors.ItemData(lstVendors.ListIndex)

        ' Open the database and the Vendors table. Open the database
        ' read-only since we only plan to read from it.

        Set db = DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, False, True)
        Set tbl = db.OpenRecordset("Vendors", dbOpenTable)

        ' Set the index to the primary key (the vendor number), find the
        ' desired record, and gently remind the database engine to unlock
        ' the index.

        tbl.Index = "PrimaryKey"
        tbl.Seek "=", vendorNumber
        DBEngine.Idle dbFreeLocks

        ' Read the vendor information from the database into the controls
        ' of the vendor details form.

        frmVendorDetails.lblNumber = tbl("Vendor Number")
        If Not IsNull(tbl("Name")) Then frmVendorDetails.lblName = _
            tbl("Name") Else frmVendorDetails.lblName = ""
        If Not IsNull(tbl("Address")) Then frmVendorDetails.lblAddress = _
            tbl("Address") Else frmVendorDetails.lblAddress = ""
        If Not IsNull(tbl("FEIN")) Then frmVendorDetails.lblFEIN = _
            tbl("FEIN") Else frmVendorDetails.lblFEIN = ""

        ' Close the table and display the vendor details form as a modal form.

        tbl.Close
        frmVendorDetails.Show 1

    Else

        ' The user clicked Vendor Details without first selecting a vendor.

        Beep
        MsgBox "You haven't selected a vendor", vbExclamation

    End If

Exit Sub

VendorDetailsError:

    ' An error has occurred. Inform the user of the error and exit from the
    ' procedure.

    MsgBox Error(Err)

Exit Sub

End Sub
Private Sub Form_Load()

    Dim db As DATABASE

    ' Assign fully qualified pathnames to the form level data file variables.
    PathToData = DataPath()
    VendorFile = PathToData & "\CHAPTER.04\VENDORS.DAT"
    InvoiceFile = PathToData & "\CHAPTER.04\INVOICES.DAT"
    DatabaseFile = PathToData & "\CHAPTER.04\ACCTSPAY.MDB"

    ' Initialize the grid control.
    InitializeGrid

    ' Delete any existing data in the Vendors and Invoices tables.
    Set db = DBEngine.Workspaces(0).OpenDatabase(DatabaseFile)
    db.Execute ("DELETE Vendors.* from Vendors")
    db.Execute ("DELETE Invoices.* from Invoices")


End Sub
Private Sub InitializeGrid()

    Const GRID_ALIGNLEFT = 0
    Const GRID_ALIGNRIGHT = 1
    Const GRID_ALIGNCENTER = 2

    ' Set up the column widths for the grid. We're not using column 0,
    ' so set its width to one pixel (the minimum allowable).

    grdInvoices.ColWidth(0) = 1
    grdInvoices.ColWidth(1) = 1200
    grdInvoices.ColWidth(2) = 1200
    grdInvoices.ColWidth(3) = 1200

    ' Set column alignments.

    grdInvoices.ColAlignment(1) = GRID_ALIGNLEFT
    grdInvoices.ColAlignment(2) = GRID_ALIGNCENTER
    grdInvoices.ColAlignment(3) = GRID_ALIGNRIGHT
    grdInvoices.FixedAlignment(1) = GRID_ALIGNLEFT
    grdInvoices.FixedAlignment(2) = GRID_ALIGNCENTER
    grdInvoices.FixedAlignment(3) = GRID_ALIGNRIGHT

    ' Insert the column titles in the top row of the grid.

    grdInvoices.Row = 0
    grdInvoices.Col = 1
    grdInvoices.TEXT = "Inv #"
    grdInvoices.Col = 2
    grdInvoices.TEXT = "Date"
    grdInvoices.Col = 3
    grdInvoices.TEXT = "Amount"

    ' Initialize the grid to show only the title row.

    grdInvoices.Rows = 1

End Sub
Private Sub FillInvoiceList(vendor As Integer)

    ' This procedure is called when the user clicks on a vendor name.
    ' It fills the grid with the invoices for that vendor currently in the
    ' data base. The vendor argument is the vendor number of the selected
    ' vendor.

    Dim db As DATABASE
    Dim snap As Recordset
    Dim rownum As Integer
    Dim sql As String

    ' Create a new collection for invoices and a variable to assign
    ' individual invoices to.

    Dim invoicesCollection As New Collection
    Dim inv As clsInvoice

    ' Set up the error handler.

    On Error GoTo FillInvoiceListError

    ' Open the database and create a snapshot consisting of the invoice
    ' records for the vendor passed as the argument. Open the database
    ' read-only since we only need to read records.

    Set db = DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, False, True)
    sql = "SELECT [Invoice Number] FROM Invoices"
    sql = sql & " WHERE [Vendor Number] = " & vendor
    Set snap = db.OpenRecordset(sql, dbOpenSnapshot)

    If snap.RecordCount > 0 Then

        ' At least one record was retrieved, so process each record.

        snap.MoveFirst
        Do While Not snap.EOF

            ' Create a new clsInvoice object and assign it to a variable.

            Set inv = New clsInvoice

            ' Use the Retrieve method of clsInvoice to get the invoice
            ' from the database and add it to the invoices collection.

            If inv.Retrieve(db, vendor, snap("Invoice Number")) Then
                invoicesCollection.Add inv
            End If

            snap.MoveNext

        Loop

        ' Set the number of rows in the grid to the number of invoices
        ' retrieved. plus one for the headings row.

        grdInvoices.Rows = invoicesCollection.Count + 1

        ' Cycle through the invoices collection. Assign each to the
        ' clsInvoice variable inv and use the class's AddToGrid method to
        ' add the invoice to the grid.

        For rownum = 1 To invoicesCollection.Count
            Set inv = invoicesCollection.Item(rownum)
            inv.AddToGrid grdInvoices, rownum
        Next rownum

    Else

        ' The snapshot is empty; there are no invoices in the database for
        ' this user. Set the grid to show just the header row.

        grdInvoices.Rows = 1

    End If

Exit Sub

FillInvoiceListError:

    ' Display the standard error message, reset the grid to show just the
    ' heading row, and deselect the vendor's name in the vendor list.

    grdInvoices.Rows = 1
    lstVendors.ListIndex = -1
    MsgBox Error(Err)

Exit Sub

End Sub
Private Sub lstVendors_Click()

    ' Get the selected vendor's vendor number from the selected item's
    ' ItemData value, and pass that value to the FillInvoiceList routine,
    ' which fills the grid with invoices from this vendor.

    FillInvoiceList lstVendors.ItemData(lstVendors.ListIndex)

End Sub
Private Sub cmdListVendors_Click()

    ' This procedure gets a list of vendors from the database and displays
    ' it in the list box.

    Dim db As DATABASE
    Dim tbl As Recordset

    ' Set up the error handler.

    On Error GoTo ListVendorsError

    ' Open the database and Vendors table. Open the database read-only since
    ' reading is all we need to do.

    Set db = DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, False, True)
    Set tbl = db.OpenRecordset("Vendors", dbOpenTable)
    tbl.MoveFirst
    Do While Not tbl.EOF
        lstVendors.AddItem tbl("Name")
        lstVendors.ItemData(lstVendors.NewIndex) = tbl("Vendor Number")
        tbl.MoveNext
    Loop
    tbl.Close

Exit Sub

ListVendorsError:

    ' Inform the user of the error, clear the vendors list, and exit from
    ' the procedure.

    lstVendors.Clear
    MsgBox Error(Err)

End Sub